home *** CD-ROM | disk | FTP | other *** search
/ TPUG - Toronto PET Users Group / TPUG Users Group CD / TPUG Users Group CD.iso / COMAL / B-Book Series / (k)b3.d64 / program97 < prev    next >
Text File  |  2007-02-28  |  1KB  |  53 lines
  1. 0010 // PROGRAM 97
  2. 0020 //
  3. 0030 // COMELY KATE
  4. 0040 //
  5. 0050 // TO TEST FOR LEAP YEAR
  6. 0060 //
  7. 0070 DIM YEAR$ OF 10
  8. 0080 PRINT 
  9. 0090 INPUT "ENTER YEAR ": YEAR$
  10. 0100 TESTLEAPYEAR
  11. 0110 END 
  12. 0120 //
  13. 0130 PROC TESTLEAPYEAR 
  14. 0140 CHECKVALIDENTRY
  15. 0150 PRINT 
  16. 0160 IF NOT VALID THEN
  17. 0170 PRINT "INVALID ENTRY"
  18. 0180 ELSE 
  19. 0190 YEARVAL:=VAL(YEAR$)
  20. 0200 IF YEARVAL MOD 400=0 OR YEARVAL MOD 4<>0 THEN
  21. 0210 PRINT YEARVAL," IS NOT A LEAP YEAR"
  22. 0220 ELSE 
  23. 0230 PRINT YEARVAL," IS A LEAP YEAR"
  24. 0240 ENDIF 
  25. 0250 ENDIF 
  26. 0260 ENDPROC TESTLEAPYEAR
  27. 0270 //
  28. 0280 PROC CHECKVALIDENTRY 
  29. 0290 DIM DIGITS$ OF 10
  30. 0300 DIGITS$:="0123456789"
  31. 0310 POSITION:=1
  32. 0320 VALID:=TRUE
  33. 0330 REPEAT 
  34. 0340 IF YEAR$(POSITION) IN DIGITS$ THEN
  35. 0350 POSITION:=POSITION+1
  36. 0360 ELSE 
  37. 0370 VALID:=FALSE
  38. 0380 ENDIF 
  39. 0390 UNTIL POSITION>LEN(YEAR$) OR NOT VALID
  40. 0400 ENDPROC CHECKVALIDENTRY
  41. 9000 //
  42. 9010 FUNC VAL(S$) CLOSED
  43. 9020 // VERSION 0.14 ONLY : VERSION 2.00 USE KEYWORD VAL
  44. 9030 // INTEGER VALUES ONLY
  45. 9040 LENGTH:=LEN(S$)
  46. 9050 ONES:=ORD(S$(LENGTH))-ORD("0")
  47. 9060 IF LENGTH=1 THEN
  48. 9070 RETURN ONES
  49. 9080 ELSE 
  50. 9090 RETURN ONES+VAL(S$(1:LENGTH-1))*10 // RECURSIVE CALL
  51. 9100 ENDIF 
  52. 9110 ENDFUNC VAL
  53.